home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 4 / Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso / Development / General / PG PRO⁄PG Lite Demos / PG Writer π / PG Writer.MAIN < prev    next >
Text File  |  1994-03-28  |  8KB  |  296 lines
  1. '===============================================================================
  2. '=                     Copyright 1992 Staz™ Software, Inc.                     =
  3. '=                             All rights reserved                             =
  4. '=                          "Project.MAIN" from PG:PRO                         =
  5. '===============================================================================
  6. RESOURCES "PG Writer.RSRC","APPLpG3!"
  7. COMPILE 1,140'set by PG:PRO
  8. WINDOW OFF : WIDTH -2'standard
  9. '
  10. '{PG3} <-- PG PRO uses these as a source code markers.  Do not remove them.
  11. GLOBALS "PG PRO.GLBL"
  12. GLOBALS "PG Writer.GLBL"
  13. END GLOBALS
  14. EDIT = 2'set EDIT/PICTURE FIELD border
  15. INCLUDE "PG PRO.INCL"
  16. SEGMENT
  17. INCLUDE "PG Writer.INCL"
  18. SEGMENT
  19. INCLUDE "Edit Menu.FLTR"
  20. INCLUDE "Font.FLTR"
  21. '{PG4}
  22. '===============================================================================
  23. "@Filters":SEGMENT:                REM Use the area below for additional filters
  24. '-------------------------------------------------------------------------------
  25.  
  26. '===============================================================================
  27. SELECT gAction'primary branch
  28. '---------------------------------------------------------------------------
  29. CASE _mainAction   :GOSUB "Action:Main"'appl level events
  30. CASE _menuAction   :GOSUB "Action:Menu"'menu actions
  31. CASE _buttonAction :GOSUB "Action:Button"'button clicked
  32. CASE _mouseAction  :GOSUB "Action:Mouse"'mouse down in whichClass
  33. CASE _windowAction :GOSUB "Action:Window"'window actions
  34. CASE _fieldAction  :GOSUB "Action:Field"'edit fields actions
  35. CASE _otherAction  :GOSUB "Action:Other"'low level events
  36. END SELECT:RETURN'end of primary selection
  37. '===============================================================================
  38. "@Includes":SEGMENT:         REM Use the area below for additional ".INCL" files
  39. '-------------------------------------------------------------------------------
  40.  
  41. '===============================================================================
  42. "@Long Functions":SEGMENT:       REM Put your application's long functions below
  43. '-------------------------------------------------------------------------------
  44. LOCAL FN fixMenuBar
  45. setColorTo = _disable
  46. LONG IF gActiveWnd = _docWnd
  47. setMenusTo = _enable
  48. IF SYSTEM(_crntDepth) > 2 THEN setColorTo = _enable
  49. XELSE
  50. setMenusTo = _disable
  51. gSaveName$ = ""
  52. END IF
  53. MENU _fontMenu  ,0,setMenusTo
  54. MENU _sizeMenu  ,0,setMenusTo
  55. MENU _styleMenu ,0,setMenusTo
  56. MENU _colorMenu ,0,setColorTo
  57. END FN
  58. '===============================================================================
  59. LOCAL FN fixMenuItems
  60. LONG IF gActiveWnd = _docWnd
  61. MENU _fileMenu,_openItem ,_disable
  62. MENU _fileMenu,_newItem  ,_disable
  63. MENU _fileMenu,_closeItem,_enable
  64. LONG IF WINDOW(_EFTextLen)
  65. MENU _fileMenu,_printItem,_enable
  66. XELSE
  67. MENU _fileMenu,_printItem,_disable
  68. END IF
  69. XELSE
  70. MENU _fileMenu,_openItem ,_enable
  71. MENU _fileMenu,_newItem  ,_enable
  72. MENU _fileMenu,_closeItem,_disable
  73. MENU _fileMenu,_printItem,_disable
  74. END IF
  75. END FN
  76. '===============================================================================
  77. LOCAL FN saveFile
  78. GET FIELD fldHndl&,_docFld
  79. DEF OPEN "mTxtmRit"
  80. OPEN "R",#1,gSaveName$,,gSaveVol
  81. WRITE FIELD #1,fldHndl&
  82. CLOSE #1
  83. gDirty = _false
  84. CALL SETWTITLE(WINDOW(_wndpointer),gSaveName$)
  85. END FN
  86. '===============================================================================
  87. LOCAL FN openFile
  88. gSaveName$ = gOpenName$
  89. gSaveVol   = gOpenVol
  90. gDirty     = _false
  91. fldHndl& = 0
  92. OPEN "R",#1,gSaveName$,1,gSaveVol
  93. LONG IF gFileType& = _"TEXT"
  94. lgth& = LOF(1)
  95. IF lgth& > 32000 THEN lgth& = 32000
  96. fldHndl& = FN NEWHANDLE(lgth&+2)
  97. LONG IF fldHndl&
  98. READ FILE #1,[fldHndl&]+2,lgth&
  99. % [fldHndl&],lgth&
  100. END IF
  101. XELSE
  102. READ FIELD #1,fldHndl&
  103. END IF
  104. CLOSE #1
  105. LONG IF fldHndl&
  106. FN pGbuild(_docWnd)
  107. EDIT FIELD _docFld,&fldHndl&
  108. DEF DISPOSEH (fldHndl&)
  109. CALL SETWTITLE(WINDOW(_wndpointer),gSaveName$)
  110. END IF
  111. END FN
  112. '===============================================================================
  113. LOCAL FN printFile
  114. DIM my,mx
  115. DIM t,l,b,r
  116. CURSOR _arrowCursor
  117. DEF LPRINT
  118. LONG IF PRCANCEL = _false
  119.  
  120. CURSOR _watchCursor
  121. t;8 = [PRHANDLE] + _prInfo + _rPage
  122.  
  123. GET FIELD b4Print&,_docFld
  124. oldStart = WINDOW(_selStart)
  125. oldEnd   = WINDOW(_selEnd)
  126.  
  127. WHILE WINDOW(_EFTextLen)
  128. my = b:mx = l-1
  129. theChar = FN TEGETOFFSET(my,TEHANDLE(_docFld))
  130. SETSELECT 0,theChar
  131. CALL TECUT(TEHANDLE(_docFld))
  132.  
  133. CALL OFFSETRECT(t,-5000,0)
  134. EDIT FIELD -1,,@t,_statnoframed
  135. CALL TESTYLPASTE(TEHANDLE(1))
  136. GET FIELD tempHndl&,1
  137. EDIT FIELD CLOSE 1
  138. CALL OFFSETRECT(t,5000,0)
  139.  
  140. ROUTE #128
  141. EDIT FIELD -1,&tempHndl&,@t,_statnoframed
  142. KILL FIELD tempHndl&
  143. ROUTE#0
  144.  
  145. LONG IF WINDOW(_EFTextLen)
  146. CLEAR LPRINT
  147. XELSE
  148. CLOSE LPRINT
  149. END IF
  150. WEND
  151.  
  152. EDIT$(_docFld) = &b4Print&
  153. SETSELECT oldStart,oldEnd
  154. KILL FIELD b4Print&
  155.  
  156. END IF
  157. END FN
  158. '===============================================================================
  159. "Action:Main"
  160. '-------------------------------------------------------------------------------
  161. SELECT gSubAction
  162. CASE _mainStart
  163. gOpenType$  = "TEXTmTxt"
  164. gFixMenubar = _zTrue
  165. CASE _mainOpen
  166. FN openFile
  167. CASE _mainSave
  168. FN saveFile
  169. CASE _mainPrint
  170. FN openFile
  171. FN printFile
  172. FN pGclose(_docWnd)
  173. CASE _mainTimer
  174. CASE _mainShutDown
  175. END SELECT:RETURN
  176. '===============================================================================
  177. "Action:Menu"
  178. '-------------------------------------------------------------------------------
  179. SELECT gWhichMenu
  180. CASE _appleResMenu
  181. FN pGbuild(-_splashWnd)
  182. CASE _fileMenu
  183. SELECT gWhichItem
  184. CASE _newItem
  185. gSaveName$ = "Untitled"
  186. FN pGbuild(_docWnd)
  187. gDirty     = _false
  188. CASE _pageSetupItem
  189. DIALOG = _fixPageMessage
  190. CASE _printItem
  191. FN printFile
  192. END SELECT
  193. CASE _colorMenu
  194. mHndl& = FN GETMHANDLE(_colorMenu)
  195. LONG IF mHndl&
  196. CALL GETITEM(mHndl&,1,t$):red   = VAL(t$)
  197. CALL GETITEM(mHndl&,2,t$):green = VAL(t$)
  198. CALL GETITEM(mHndl&,3,t$):blue  = VAL(t$)
  199. EDIT TEXT ,,,,red,green,blue
  200. END IF
  201. END SELECT:RETURN
  202. '===============================================================================
  203. "Action:Button"
  204. '-------------------------------------------------------------------------------
  205. SELECT gWhichClass
  206. END SELECT:RETURN
  207. '===============================================================================
  208. "Action:Mouse"
  209. '-------------------------------------------------------------------------------
  210. SELECT gWhichClass
  211.  
  212. END SELECT:RETURN
  213. '===============================================================================
  214. "Action:Window"
  215. '-------------------------------------------------------------------------------
  216. SELECT gSubAction
  217. CASE _windowClose
  218. gFixMenubar = _zTrue
  219. LONG IF gDirty
  220. t$ = gSaveName$
  221. CALL PARAMTEXT(t$,"closing","","")
  222. FN pGcntrRes(_"ALRT",132)
  223. whichAlertBtn = FN ALERT(132,0)
  224. SELECT whichAlertBtn
  225. CASE 1:'save
  226. FN pGautoMenu(_fileMenu,_saveAsItem)
  227. CASE 2:'don't save
  228. CASE 3:'cancel
  229. gFixMenubar = _false
  230. gAction     = 0
  231. END SELECT
  232. END IF
  233. CASE _windowUpdate
  234. CASE _windowActivate  :gFixMenubar = _zTrue
  235. CASE _windowDeactivate:gFixMenubar = _zTrue
  236. CASE _windowSized
  237. CASE _windowMoved
  238. CASE _windowClicked
  239. CASE _windowWillZoomOut
  240. CASE _windowWillZoomIn
  241. CASE _windowWillGrow
  242. CASE _windowDocWillMove
  243. END SELECT:RETURN
  244. '===============================================================================
  245. "Action:Field"
  246. '-------------------------------------------------------------------------------
  247. SELECT gSubAction
  248. CASE _fieldActivate
  249. CASE _fieldChanging
  250. CASE _fieldKeyPressed
  251. gDirty = _zTrue
  252. CASE _fieldReturn
  253. CASE _fieldTab
  254. CASE _fieldShiftTab
  255. CASE _fieldClear
  256. CASE _fieldLeft
  257. CASE _fieldRight
  258. CASE _fieldUp
  259. CASE _fieldDown
  260. CASE _fieldClicked
  261. END SELECT:RETURN
  262. '===============================================================================
  263. "Action:Other"
  264. '-------------------------------------------------------------------------------
  265. SELECT gSubAction
  266. CASE _otherDisk:gAction=0    :    REM Prevents SFOpen dialog on disk insert
  267. CASE _otherSwitch
  268. CASE _otherScrap
  269. CASE _otherCursor
  270. CASE _otherKeyPressed
  271. CASE _otherBeforeMenu
  272. FN fixMenuItems
  273. CASE _otherNullEvent
  274. LONG IF gFixMenubar
  275. gFixMenubar = _false
  276. FN fixMenuBar
  277. END IF
  278. CASE _otherFilterEvent
  279. CASE _otherUser
  280. LONG IF gDialogValue = _fixPageMessage
  281. CLS
  282. FN pGfixEditor
  283. END IF
  284. CASE _otherUserInit
  285. CASE _otherUserUpdate
  286. CASE _otherUserClick
  287. CASE _otherUserDispose
  288. END SELECT:RETURN
  289. '===============================================================================
  290. "@Subroutines":SEGMENT:             REM Put your application's subroutines below
  291. '-------------------------------------------------------------------------------
  292.  
  293. '===============================================================================
  294.  
  295.  
  296.